home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / UGPRG.ZIP / DENTHOR / TUT16.DOC < prev    next >
Encoding:
Text File  |  1996-07-27  |  25.4 KB  |  786 lines

  1.                    ╒═══════════════════════════════╕
  2.                    │         W E L C O M E         │
  3.                    │  To the VGA Trainer Program   │ │
  4.                    │              By               │ │
  5.                    │      DENTHOR of ASPHYXIA      │ │ │
  6.                    ╘═══════════════════════════════╛ │ │
  7.                      ────────────────────────────────┘ │
  8.                        ────────────────────────────────┘
  9.  
  10.                            --==[ PART 16 ]==--
  11.  
  12.  
  13.  
  14. =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  15. ■ Introduction
  16.  
  17. Hi there. This trainer is on the scaling of an arbitrary sized bitmap to
  18. screen in two dimensions. The sample program seems to work quite quickly,
  19. and the code is document. The scaling procedure is however totally in
  20. assembler ... hopefully this won't cause to many problems.
  21.  
  22. EzE has released a trainer! It is on the speeding up of 3D for normal 3D
  23. and for virtual worlds. Check it out, it is quite good (even though I get
  24. a bit of ribbing in his quote ;-)) It will be in PCGPE ][, to be released
  25. shortly.
  26.  
  27. I have set up a mailserver (that doesn't seem to work all the time, but
  28. the ones that miss I post manually). It works like this :
  29.  
  30. Send mail to denthor@beastie.cs.und.ac.za with the subject line :
  31. request-list ... it will automatically mail you back with a list of
  32. subject lines with which you can grab certain files. You will then mail me
  33. with the subject line of a specific file and it will send you a uuencoded
  34. version of that file automatically. Cool, huh?
  35.  
  36. Remember, no more mail to smith9@batis.bis.und.ac.za, send it all to
  37. denthor@beastie.cs.und.ac.za ! Thanks.
  38.  
  39.  
  40. If you would like to contact me, or the team, there are many ways you
  41. can do it : 1) Write a message to Grant Smith/Denthor/Asphyxia in private mail
  42.                   on the ASPHYXIA BBS.
  43.             2) Write to :  Grant Smith
  44.                            P.O.Box 270 Kloof
  45.                            3640
  46.                            Natal
  47.                            South Africa
  48.             3) Call me (Grant Smith) at (031) 73 2129 (leave a message if you
  49.                   call during varsity). Call +27-31-73-2129 if you call
  50.                   from outside South Africa. (It's YOUR phone bill ;-))
  51.             4) Write to denthor@beastie.cs.und.ac.za in E-Mail.
  52.             5) Write to asphyxia@beastie.cs.und.ac.za to get to all of
  53.                us at once.
  54.  
  55. NB : If you are a representative of a company or BBS, and want ASPHYXIA
  56.        to do you a demo, leave mail to me; we can discuss it.
  57. NNB : If you have done/attempted a demo, SEND IT TO ME! We are feeling
  58.         quite lonely and want to meet/help out/exchange code with other demo
  59.         groups. What do you have to lose? Leave a message here and we can work
  60.         out how to transfer it. We really want to hear from you!
  61.  
  62.  
  63.  
  64. =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  65. ■  What is scaling?
  66.  
  67. I think that most of you know this one already, but here goes. Let us say
  68. you have a picture (10x10 pixels) and you want to draw it to a different
  69. size (say 5x7 pixel), the process of altering the picture to fit into the
  70. new size is called scaling. Scaling only works on rectangular areas.
  71.  
  72. With scaling to can easily strech and shrink your bitmaps.
  73.  
  74.  
  75. =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  76. ■  Okay, so how do we code it?
  77.  
  78. Right. The way I am going to do scaling is as follows :
  79.  
  80. For the horizontal area, I am going to calculate a certain step value. I
  81. will then trace along the bitmap, adding this step to my position, and
  82. placing the nearest pixel on to the screen. Let me explain this simpler ...
  83.  
  84. Let us say I have a 10 pixel wide bitmap. I want to squish it into 5 pixels.
  85. Along the bitmap, I would draw every second pixel to screen. In ascii :
  86.  
  87.   1234567890   13579
  88.   +--------+   +---+
  89.   |        |   |   |
  90.   | bitmap |   |   |dest
  91.   |        |   |   |
  92.   +--------+   +---+
  93.  
  94. As you can see, by stepping through every second pixel, I have shrunk the
  95. bitmap to a width of 5 pixels.
  96.  
  97. The equation is as follows :
  98.  
  99.             step = origionalwidth / wantedwidth;
  100.  
  101. Let us say we have a 100 pixel wide bitmap, which we want to get to 20 pixels.
  102.  
  103.             step = 100 / 20
  104.             step = 5
  105.  
  106. If we draw every fifth pixel from the origional bitmap, we have scaled it down
  107. correctly! This also works for all values, if step is of type real.
  108.  
  109. We also find the step for the height in the same way.
  110.  
  111. Our horizontal loop is as follows :
  112.  
  113.        For loop1:=1 to wantedwidth do BEGIN
  114.          putpixel (loop1,height,bitmap[round (curpos)],vga);
  115.          curpos:=curpos+xstep;
  116.        END;
  117.  
  118. And the vertical loop is much the same. Easy huh? So east in fact, I wrote the
  119. procedure in pure assembler for you ;-) ... don't worry, it's commented.
  120.  
  121. In the sample program, instead of using reals I have used fixed point math.
  122. Refer to tut 14 if you have any hassles with fixed point, it is fairly
  123. straightforward.
  124.  
  125. I also use psuedo 3-d perspective transforms to get the positions smooth...
  126. after Tut8, this should be a breeze.
  127.  
  128. There are no new commands in the assembler for you, so you should get by with
  129. what you learned in tut7/8 ... whew! A lot of back referencing there ;) We
  130. really are building on our knowledge :)
  131.  
  132.  
  133. =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  134. ■  In closing
  135.  
  136. Well, that is about it. As you can see the concept is easy, and in fact
  137. fairly obvious, but that didn't stop me from having to sit down with a
  138. pencil and a piece of paper a few months ago and puzzle it out ;-)
  139.  
  140. I have a lot of work ahead of me for a while, so this may be the last
  141. trainer for a few months ... unless I can find some free time available.
  142. So please be patient!
  143.  
  144.  
  145.        [ "Sir! My computer has just gone haywire!"
  146.          "What?" shouts the CO. "That is a multimilliondollar machine!
  147.            find out what's wrong! This is a critical time lieutenant!"
  148.          "Yes sir"
  149.          The young lieutenant furiously types away at the keyboard, but
  150.            the machine totally ignores her.
  151.          "What is going on, soldier?"
  152.          "I don't know sir! It is just doing totally arbitrary things
  153.            after it's assigned tasks are completed. In the computer world
  154.            this is known as Denthorisms."
  155.          The computer starts to make random beeps, and prints out a payroll
  156.            program.
  157.          "Get it working NOW soldier"
  158.          The lieutenant ignores him, and contines typing. She gets partial
  159.            control of the system, she can run programs, but the computer is
  160.            continually running arb tasks in the background. One of the
  161.            techhies who have gathered behing her suddenly cries "Hey! It's
  162.            accessing the missile codes! It wants to launch them!"
  163.          The typing gathers speed, but to no avail. Another techhie says
  164.            "I could disconnect the computer from the link, but that would take
  165.            hours! And this thing will have the codes in under five minutes
  166.            at the speed it's going!"
  167.          A smile forms on the lieutanants face, and she leans back in her chair.
  168.          "What the hell are you doing?" yells the CO. "Why have you stopped?"
  169.          Again ignoring him, the lieutenant instead turns to the techhie. "Go
  170.            disconnect the machine, I know how to get you the time you need."
  171.          "How on earth will you do that? The machines going at top speed!"
  172.          She smiles again, leans forward, types in three letters and hits the
  173.            carriage return. The computer grinds to a halt.
  174.          The smile breaks into a grin. "Maybe it _does_ have it's uses after
  175.            all."
  176.                                                                         ]
  177.                                                          - Grant Smith
  178.                                                              15:30
  179.                                                                23-9-94
  180.  
  181. Byeeeee.....
  182.  
  183. The following are official ASPHYXIA distribution sites :
  184.  
  185. ╔══════════════════════════╦════════════════╦═════╗
  186. ║BBS Name                  ║Telephone No.   ║Open ║
  187. ╠══════════════════════════╬════════════════╬═════╣
  188. ║ASPHYXIA BBS #1           ║+27-31-765-5312 ║ALL  ║
  189. ║ASPHYXIA BBS #2           ║+27-31-765-6293 ║ALL  ║
  190. ║C-Spam BBS                ║410-531-5886    ║ALL  ║
  191. ║POP!                      ║+27-12-661-1257 ║ALL  ║
  192. ║Soul Asylum               ║+358-0-5055041  ║ALL  ║
  193. ║Wasted Image              ║407-838-4525    ║ALL  ║
  194. ║Reckless Life             ║351-01-716 67 58║ALL  ║
  195. ╚══════════════════════════╩════════════════╩═════╝
  196.  
  197. Leave me mail if you want to become an official Asphyxia BBS
  198. distribution site.
  199. {$X+}
  200. USES crt,gfx2;
  201.  
  202. Type Pallette = Array [0..255,1..3] of byte;
  203.  
  204. VAR virscr2:virtptr;
  205.     vaddr2:word;
  206.  
  207. {──────────────────────────────────────────────────────────────────────────}
  208. Procedure LoadCELPal (FileName : String; Var Palette : Pallette);
  209.   { This loads in the pallette of the .CEL file into the variable Palette }
  210. Var
  211.   Fil : file;
  212. Begin
  213.   Assign (Fil, FileName);
  214.   Reset (Fil, 1);
  215.   Seek(Fil,32);
  216.   BlockRead (Fil, Palette, 768);
  217.   Close (Fil);
  218. End;
  219.  
  220.  
  221. {──────────────────────────────────────────────────────────────────────────}
  222. Procedure Init;
  223. VAR loop1,loop2:integer;
  224.     tpal:pallette;
  225. BEGIN
  226.   getmem (virscr2,sizeof(virscr2^));
  227.   vaddr2:=seg(virscr2^);
  228.   cls (vaddr2,0);
  229.   cls (vaddr,0);
  230.   loadcelpal ('to.cel',tpal);
  231.   for loop1:=0 to 255 do
  232.     pal (loop1,tpal[loop1,1],tpal[loop1,2],tpal[loop1,3]);
  233.   loadcel ('to.cel',virscr);
  234.   for loop1:=0 to 319 do
  235.     for loop2:=0 to 199 do
  236.       if getpixel (loop1,loop2,vaddr)=0 then
  237.         putpixel (loop1,loop2,(loop1+loop2) mod 256,vaddr);
  238. END;
  239.  
  240. {──────────────────────────────────────────────────────────────────────────}
  241. Procedure Scale (x,y,w,h,origw,origh,source,dest:word); assembler;
  242.   { This scales the picture to the size of w and h, and places the result
  243.     at x , y. Origw and origh are the origional width and height of the
  244.     bitmap. The bitmap must start at the beginning of a segment, with
  245.     source being the segment value. The image is placed in screen at dest}
  246. VAR jx,jy,depth,temp:word;
  247. asm
  248.   push  ds
  249.  
  250.   mov   ax,source
  251.   mov   ds,ax
  252.   mov   ax,dest
  253.   mov   es,ax
  254.   mov   depth,0
  255.   dec   h
  256.  
  257.   xor   dx,dx
  258.   mov   ax,origw
  259.   shl   ax,6
  260.   mov   bx,w
  261.   div   bx
  262.   shl   ax,2
  263.   mov   jx,ax     { jx:=origw*256/w }
  264.  
  265.   xor   dx,dx
  266.   mov   ax,origh
  267.   shl   ax,6
  268.   mov   bx,h
  269.   div   bx
  270.   shl   ax,2
  271.   mov   jy,ax     { jy:=origh*256/h }
  272.  
  273.   xor   cx,cx
  274. @Loop2 :          { vertical loop }
  275.   push  cx
  276.   mov   ax,depth
  277.   add   ax,jy
  278.   mov   depth,ax
  279.  
  280.   xor   dx,dx
  281.   mov   ax,depth
  282.   shr   ax,8
  283.   mov   bx,origw
  284.   mul   bx
  285.   mov   temp,ax   { temp:=depth shr 8*origw;}
  286.  
  287.  
  288.   mov   di,y
  289.   add   di,cx
  290.   mov   bx,di
  291.   shl   di,8
  292.   shl   bx,6
  293.   add   di,bx
  294.   add   di,x      { es:di = dest ... di=(loop1+y)*320+x }
  295.  
  296.   mov   cx,w
  297.   xor   bx,bx
  298.   mov   dx,jx
  299.   mov   ax,temp
  300. @Loop1 :          { horizontal loop }
  301.   mov   si,bx
  302.   shr   si,8
  303.   add   si,ax     { ax = temp = start of line }
  304.  
  305.   movsb           { si=temp+(si shr 8) }
  306.   add   bx,dx
  307.  
  308.   dec   cx
  309.   jnz   @loop1    { horizontal loop }
  310.  
  311.   pop   cx
  312.   inc   cx
  313.   cmp   cx,h
  314.   jl    @loop2    { vertical loop }
  315.  
  316.   pop   ds
  317. end;
  318.  
  319. {──────────────────────────────────────────────────────────────────────────}
  320. Procedure Play;
  321. VAR x,y,z,loop1:integer;
  322. BEGIN
  323.   z:=114;
  324.   while keypressed do readkey;
  325.   Repeat
  326.     for loop1:=1 to 50 do BEGIN
  327.       dec (z,2);
  328.       x:=16 shl 8 div z;
  329.       y:=10 shl 8 div z; { Perspective transforms ... makes the zoom smoother }
  330.       cls (vaddr2,0);
  331.       scale (160-(x shr 1),100-(y shr 1),x,y,320,200,vaddr,vaddr2);
  332.       flip (vaddr2,vga);
  333.     END;   { Scale towards you }
  334.     for loop1:=1 to 50 do BEGIN
  335.       inc (z,2);
  336.       x:=16 shl 8 div z;
  337.       y:=10 shl 8 div z; { Perspective transforms ... makes the zoom smoother }
  338.       cls (vaddr2,0);
  339.       scale (160-(x shr 1),100-(y shr 1),x,y,320,200,vaddr,vaddr2);
  340.       flip (vaddr2,vga);
  341.     END;   { Scale away from you }
  342.   Until keypressed;
  343.   while keypressed do readkey;
  344. END;
  345.  
  346. BEGIN
  347.   clrscr;
  348.   writeln ('Hokay! Here is the sixteenth tutorial! This one is on nice fast 2d');
  349.   writeln ('scaling, for any size bitmap. Just hit any key and it will scale a');
  350.   writeln ('picture up and down. Clipping is NOT performed, so the destination');
  351.   writeln ('pic MUST fit in the screen boundaries. In one zoom towards and away');
  352.   writeln ('from you there is 100 frames.');
  353.   writeln;
  354.   Writeln ('You can make many nice effects with scaling, this "bouncing" is just');
  355.   writeln ('one of them ... go on, amaze everyone with your ingenuity ;-) Also,');
  356.   writeln ('why not test your coding mettle, so to speak, by implementing clipping?');
  357.   Writeln;
  358.   writeln ('The routine could greatly be speeded up with 386 extended registers, but');
  359.   writeln ('for the sake of compatability I have kept it to 286 code. Also, this');
  360.   writeln ('routine isn''t fully optimised .. you may be able to get some speedups');
  361.   writeln ('out of it... (probably by moving the finding of DI out of the loop and');
  362.   writeln ('just adding a constant for each line ... hint hint) ;)');
  363.   writeln;
  364.   writeln ('The pic was drawn by me for Tut11, I am reusing it because I am at varsity..');
  365.   writeln ('without a mouse. :(');
  366.   writeln;
  367.   writeln;
  368.   writeln ('Hit any key to continue ... ');
  369.   readkey;
  370.   setupvirtual;
  371.   setmcga;
  372.   init;
  373.   play;
  374.   settext;
  375.   shutdown;
  376.   freemem (virscr2,sizeof(virscr2^));
  377.   Writeln ('All done. This concludes the sixteenth sample program in the ASPHYXIA');
  378.   Writeln ('Training series. You may reach DENTHOR under the names of GRANT');
  379.   Writeln ('SMITH/DENTHOR/ASPHYXIA on the ASPHYXIA BBS.I also occasinally');
  380.   Writeln ('RSAProg, comp.lang.pascal and comp.sys.ibm.pc.demos. E-mail me at :');
  381.   Writeln ('    denthor@beastie.cs.und.ac.za');
  382.   Writeln ('The numbers are available in the main text. You may also write to me at:');
  383.   Writeln ('             Grant Smith');
  384.   Writeln ('             P.O. Box 270');
  385.   Writeln ('             Kloof');
  386.   Writeln ('             3640');
  387.   Writeln ('             Natal');
  388.   Writeln ('             South Africa');
  389.   Writeln ('I hope to hear from you soon!');
  390.   Writeln; Writeln;
  391.   Write   ('Hit any key to exit ...');
  392.   readkey;
  393. END.
  394. Unit GFX2;
  395.  
  396.  
  397. INTERFACE
  398.  
  399. USES crt;
  400. CONST VGA = $A000;
  401.  
  402. TYPE Virtual = Array [1..64000] of byte;  { The size of our Virtual Screen }
  403.      VirtPtr = ^Virtual;                  { Pointer to the virtual screen }
  404.  
  405. VAR Virscr : VirtPtr;                     { Our first Virtual screen }
  406.     Vaddr  : word;                        { The segment of our virtual screen}
  407.  
  408. Procedure SetMCGA;
  409.    { This procedure gets you into 320x200x256 mode. }
  410. Procedure SetText;
  411.    { This procedure returns you to text mode.  }
  412. Procedure Cls (Where:word;Col : Byte);
  413.    { This clears the screen to the specified color }
  414. Procedure SetUpVirtual;
  415.    { This sets up the memory needed for the virtual screen }
  416. Procedure ShutDown;
  417.    { This frees the memory used by the virtual screen }
  418. procedure flip(source,dest:Word);
  419.    { This copies the entire screen at "source" to destination }
  420. Procedure Pal(Col,R,G,B : Byte);
  421.    { This sets the Red, Green and Blue values of a certain color }
  422. Procedure GetPal(Col : Byte; Var R,G,B : Byte);
  423.   { This gets the Red, Green and Blue values of a certain color }
  424. procedure WaitRetrace;
  425.    {  This waits for a vertical retrace to reduce snow on the screen }
  426. Procedure Hline (x1,x2,y:word;col:byte;where:word);
  427.    { This draws a horizontal line from x1 to x2 on line y in color col }
  428. Procedure Line(a,b,c,d:integer;col:byte;where:word);
  429.   { This draws a solid line from a,b to c,d in colour col }
  430. Procedure DrawPoly(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;where:word);
  431.    { This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4
  432.      in color col }
  433. Function rad (theta : real) : real;
  434.    {  This calculates the degrees of an angle }
  435. Procedure Putpixel (X,Y : Integer; Col : Byte; where:word);
  436.    { This puts a pixel on the screen by writing directly to memory. }
  437. Function Getpixel (X,Y : Integer; where:word) :Byte;
  438.    { This gets the pixel on the screen by reading directly to memory. }
  439. Procedure LoadCEL (FileName :  string; ScrPtr : pointer);
  440.   { This loads the cel 'filename' into the pointer scrptr }
  441.  
  442.  
  443. IMPLEMENTATION
  444.  
  445. {──────────────────────────────────────────────────────────────────────────}
  446. Procedure SetMCGA;  { This procedure gets you into 320x200x256 mode. }
  447. BEGIN
  448.   asm
  449.      mov        ax,0013h
  450.      int        10h
  451.   end;
  452. END;
  453.  
  454. {──────────────────────────────────────────────────────────────────────────}
  455. Procedure SetText;  { This procedure returns you to text mode.  }
  456. BEGIN
  457.   asm
  458.      mov        ax,0003h
  459.      int        10h
  460.   end;
  461. END;
  462.  
  463. {──────────────────────────────────────────────────────────────────────────}
  464. Procedure Cls (Where:word;Col : Byte); assembler;
  465.    { This clears the screen to the specified color }
  466. asm
  467.    push    es
  468.    mov     cx, 32000;
  469.    mov     es,[where]
  470.    xor     di,di
  471.    mov     al,[col]
  472.    mov     ah,al
  473.    rep     stosw
  474.    pop     es
  475. End;
  476.  
  477. {──────────────────────────────────────────────────────────────────────────}
  478. Procedure SetUpVirtual;
  479.    { This sets up the memory needed for the virtual screen }
  480. BEGIN
  481.   GetMem (VirScr,64000);
  482.   vaddr := seg (virscr^);
  483. END;
  484.  
  485. {──────────────────────────────────────────────────────────────────────────}
  486. Procedure ShutDown;
  487.    { This frees the memory used by the virtual screen }
  488. BEGIN
  489.   FreeMem (VirScr,64000);
  490. END;
  491.  
  492. {──────────────────────────────────────────────────────────────────────────}
  493. procedure flip(source,dest:Word); assembler;
  494.   { This copies the entire screen at "source" to destination }
  495. asm
  496.   push    ds
  497.   mov     ax, [Dest]
  498.   mov     es, ax
  499.   mov     ax, [Source]
  500.   mov     ds, ax
  501.   xor     si, si
  502.   xor     di, di
  503.   mov     cx, 32000
  504.   rep     movsw
  505.   pop     ds
  506. end;
  507.  
  508. {──────────────────────────────────────────────────────────────────────────}
  509. Procedure Pal(Col,R,G,B : Byte); assembler;
  510.   { This sets the Red, Green and Blue values of a certain color }
  511. asm
  512.    mov    dx,3c8h
  513.    mov    al,[col]
  514.    out    dx,al
  515.    inc    dx
  516.    mov    al,[r]
  517.    out    dx,al
  518.    mov    al,[g]
  519.    out    dx,al
  520.    mov    al,[b]
  521.    out    dx,al
  522. end;
  523.  
  524. {──────────────────────────────────────────────────────────────────────────}
  525. Procedure GetPal(Col : Byte; Var R,G,B : Byte);
  526.   { This gets the Red, Green and Blue values of a certain color }
  527. Var
  528.    rr,gg,bb : Byte;
  529. Begin
  530.    asm
  531.       mov    dx,3c7h
  532.       mov    al,col
  533.       out    dx,al
  534.  
  535.       add    dx,2
  536.  
  537.       in     al,dx
  538.       mov    [rr],al
  539.       in     al,dx
  540.       mov    [gg],al
  541.       in     al,dx
  542.       mov    [bb],al
  543.    end;
  544.    r := rr;
  545.    g := gg;
  546.    b := bb;
  547. end;
  548.  
  549. {──────────────────────────────────────────────────────────────────────────}
  550. procedure WaitRetrace; assembler;
  551.   {  This waits for a vertical retrace to reduce snow on the screen }
  552. label
  553.   l1, l2;
  554. asm
  555.     mov dx,3DAh
  556. l1:
  557.     in al,dx
  558.     and al,08h
  559.     jnz l1
  560. l2:
  561.     in al,dx
  562.     and al,08h
  563.     jz  l2
  564. end;
  565.  
  566. {──────────────────────────────────────────────────────────────────────────}
  567. Procedure Hline (x1,x2,y:word;col:byte;where:word); assembler;
  568.   { This draws a horizontal line from x1 to x2 on line y in color col }
  569. asm
  570.   mov   ax,where
  571.   mov   es,ax
  572.   mov   ax,y
  573.   mov   di,ax
  574.   shl   ax,8
  575.   shl   di,6
  576.   add   di,ax
  577.   add   di,x1
  578.  
  579.   mov   al,col
  580.   mov   ah,al
  581.   mov   cx,x2
  582.   sub   cx,x1
  583.   shr   cx,1
  584.   jnc   @start
  585.   stosb
  586. @Start :
  587.   rep   stosw
  588. end;
  589.  
  590. {──────────────────────────────────────────────────────────────────────────}
  591. Procedure Line(a,b,c,d:integer;col:byte;where:word);
  592.   { This draws a solid line from a,b to c,d in colour col }
  593.   function sgn(a:real):integer;
  594.   begin
  595.        if a>0 then sgn:=+1;
  596.        if a<0 then sgn:=-1;
  597.        if a=0 then sgn:=0;
  598.   end;
  599. var i,s,d1x,d1y,d2x,d2y,u,v,m,n:integer;
  600. begin
  601.      u:= c - a;
  602.      v:= d - b;
  603.      d1x:= SGN(u);
  604.      d1y:= SGN(v);
  605.      d2x:= SGN(u);
  606.      d2y:= 0;
  607.      m:= ABS(u);
  608.      n := ABS(v);
  609.      IF NOT (M>N) then
  610.      BEGIN
  611.           d2x := 0 ;
  612.           d2y := SGN(v);
  613.           m := ABS(v);
  614.           n := ABS(u);
  615.      END;
  616.      s := m shr 1;
  617.      FOR i := 0 TO m DO
  618.      BEGIN
  619.           putpixel(a,b,col,where);
  620.           s := s + n;
  621.           IF not (s<m) THEN
  622.           BEGIN
  623.                s := s - m;
  624.                a:= a + d1x;
  625.                b := b + d1y;
  626.           END
  627.           ELSE
  628.           BEGIN
  629.                a := a + d2x;
  630.                b := b + d2y;
  631.           END;
  632.      end;
  633. END;
  634.  
  635.  
  636. {──────────────────────────────────────────────────────────────────────────}
  637. Procedure DrawPoly(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;where:word);
  638.   { This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4
  639.     in color col }
  640. var
  641.   x:integer;
  642.   mny,mxy:integer;
  643.   mnx,mxx,yc:integer;
  644.   mul1,div1,
  645.   mul2,div2,
  646.   mul3,div3,
  647.   mul4,div4:integer;
  648.  
  649. begin
  650.   mny:=y1; mxy:=y1;
  651.   if y2<mny then mny:=y2;
  652.   if y2>mxy then mxy:=y2;
  653.   if y3<mny then mny:=y3;
  654.   if y3>mxy then mxy:=y3;    { Choose the min y mny and max y mxy }
  655.   if y4<mny then mny:=y4;
  656.   if y4>mxy then mxy:=y4;
  657.  
  658.   if mny<0 then mny:=0;
  659.   if mxy>199 then mxy:=199;
  660.   if mny>199 then exit;
  661.   if mxy<0 then exit;        { Verticle range checking }
  662.  
  663.   mul1:=x1-x4; div1:=y1-y4;
  664.   mul2:=x2-x1; div2:=y2-y1;
  665.   mul3:=x3-x2; div3:=y3-y2;
  666.   mul4:=x4-x3; div4:=y4-y3;  { Constansts needed for intersection calc }
  667.  
  668.   for yc:=mny to mxy do
  669.     begin
  670.       mnx:=320;
  671.       mxx:=-1;
  672.       if (y4>=yc) or (y1>=yc) then
  673.         if (y4<=yc) or (y1<=yc) then   { Check that yc is between y1 and y4 }
  674.           if not(y4=y1) then
  675.             begin
  676.               x:=(yc-y4)*mul1 div div1+x4; { Point of intersection on x axis }
  677.               if x<mnx then
  678.                 mnx:=x;
  679.               if x>mxx then
  680.                 mxx:=x;       { Set point as start or end of horiz line }
  681.             end;
  682.       if (y1>=yc) or (y2>=yc) then
  683.         if (y1<=yc) or (y2<=yc) then   { Check that yc is between y1 and y2 }
  684.           if not(y1=y2) then
  685.             begin
  686.               x:=(yc-y1)*mul2 div div2+x1; { Point of intersection on x axis }
  687.               if x<mnx then
  688.                 mnx:=x;
  689.               if x>mxx then
  690.                 mxx:=x;       { Set point as start or end of horiz line }
  691.             end;
  692.       if (y2>=yc) or (y3>=yc) then
  693.         if (y2<=yc) or (y3<=yc) then   { Check that yc is between y2 and y3 }
  694.           if not(y2=y3) then
  695.             begin
  696.               x:=(yc-y2)*mul3 div div3+x2; { Point of intersection on x axis }
  697.               if x<mnx then
  698.                 mnx:=x;
  699.               if x>mxx then
  700.                 mxx:=x;       { Set point as start or end of horiz line }
  701.             end;
  702.       if (y3>=yc) or (y4>=yc) then
  703.         if (y3<=yc) or (y4<=yc) then   { Check that yc is between y3 and y4 }
  704.           if not(y3=y4) then
  705.             begin
  706.               x:=(yc-y3)*mul4 div div4+x3; { Point of intersection on x axis }
  707.               if x<mnx then
  708.                 mnx:=x;
  709.               if x>mxx then
  710.                 mxx:=x;       { Set point as start or end of horiz line }
  711.             end;
  712.       if mnx<0 then
  713.         mnx:=0;
  714.       if mxx>319 then
  715.         mxx:=319;          { Range checking on horizontal line }
  716.       if mnx<=mxx then
  717.         hline (mnx,mxx,yc,color,where);   { Draw the horizontal line }
  718.     end;
  719.   end;
  720.  
  721. {──────────────────────────────────────────────────────────────────────────}
  722. Function rad (theta : real) : real;
  723.   {  This calculates the degrees of an angle }
  724. BEGIN
  725.   rad := theta * pi / 180
  726. END;
  727.  
  728. {──────────────────────────────────────────────────────────────────────────}
  729. Procedure Putpixel (X,Y : Integer; Col : Byte; where:word); assembler;
  730.   { This puts a pixel on the screen by writing directly to memory. }
  731. Asm
  732.   mov     ax,[where]
  733.   mov     es,ax
  734.   mov     bx,[X]
  735.   mov     dx,[Y]
  736.   mov     di,bx
  737.   mov     bx, dx                  {; bx = dx}
  738.   shl     dx, 8
  739.   shl     bx, 6
  740.   add     dx, bx                  {; dx = dx + bx (ie y*320)}
  741.   add     di, dx                  {; finalise location}
  742.   mov     al, [Col]
  743.   stosb
  744. End;
  745.  
  746. {──────────────────────────────────────────────────────────────────────────}
  747. Function Getpixel (X,Y : Integer; where:word):byte; assembler;
  748.   { This puts a pixel on the screen by writing directly to memory. }
  749. Asm
  750.   mov     ax,[where]
  751.   mov     es,ax
  752.   mov     bx,[X]
  753.   mov     dx,[Y]
  754.   mov     di,bx
  755.   mov     bx, dx                  {; bx = dx}
  756.   shl     dx, 8
  757.   shl     bx, 6
  758.   add     dx, bx                  {; dx = dx + bx (ie y*320)}
  759.   add     di, dx                  {; finalise location}
  760.   mov     al, es:[di]
  761. End;
  762.  
  763. {──────────────────────────────────────────────────────────────────────────}
  764. Procedure LoadCEL (FileName :  string; ScrPtr : pointer);
  765.   { This loads the cel 'filename' into the pointer scrptr }
  766. var
  767.   Fil : file;
  768.   Buf : array [1..1024] of byte;
  769.   BlocksRead, Count : word;
  770. begin
  771.   assign (Fil, FileName);
  772.   reset (Fil, 1);
  773.   BlockRead (Fil, Buf, 800);    { Read and ignore the 800 byte header }
  774.   Count := 0; BlocksRead := $FFFF;
  775.   while (not eof (Fil)) and (BlocksRead <> 0) do begin
  776.     BlockRead (Fil, mem [seg (ScrPtr^): ofs (ScrPtr^) + Count], 1024, BlocksRead);
  777.     Count := Count + 1024;
  778.   end;
  779.   close (Fil);
  780. end;
  781.  
  782.  
  783.  
  784.  
  785. BEGIN
  786. END.